home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
cmpnew
/
cmpwt.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
10KB
|
498 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpwt.h"
init_cmpwt(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
MF(VV[37],L1,start,size,data);
MF(VV[25],L2,start,size,data);
MF(VV[29],L3,start,size,data);
MF(VV[38],L4,start,size,data);
MF(VV[39],L5,start,size,data);
MF(VV[40],L6,start,size,data);
MF(VV[41],L7,start,size,data);
MM(VV[6],L8,start,size,data);
MM(VV[42],L9,start,size,data);
MM(VV[43],L10,start,size,data);
MM(VV[44],L11,start,size,data);
vs_top=vs_base=base;
}
/* function definition for WT-COMMENT */
static L1()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
if(vs_top-vs_base<1) too_few_arguments();
if(vs_top-vs_base>2) too_many_arguments();
vs_base=vs_base+1;
if(vs_base>=vs_top){vs_top=sup;goto T1;}
vs_top=sup;
goto T2;
T1:;
base[1]= Cnil;
T2:;
princ_str("\n/* ",VV[0]);
(void)(princ(base[0],symbol_value(VV[0])));
if((base[1])==Cnil){
goto T6;}
base[3]= base[1];
vs_top=(vs_base=base+3)+1;
Lsymbol_name();
vs_top=sup;
base[2]= vs_base[0];
{int V1;
int V2;
V1= length(base[2]);
V2= 0;
T14:;
if(!((V2)>=(V1))){
goto T15;}
goto T6;
T15:;
{unsigned char V3;
V3= char_code(elt(base[2],V2));
if((V3)==(47)){
goto T19;}
(void)(princ(code_char(V3),symbol_value(VV[0])));}
T19:;
V2= (V2)+1;
goto T14;}
T6:;
princ_str(" */\n",VV[0]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for WT1 */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(1);
vs_top=sup;
TTL:;
if(type_of(base[0])==t_string){
goto T28;}
if(type_of(base[0])==t_fixnum||type_of(base[0])==t_bignum){
goto T28;}
if(!(type_of(base[0])==t_character)){
goto T29;}
T28:;
(void)(princ(base[0],symbol_value(VV[0])));
goto T27;
T29:;
base[1]= base[0];
base[2]= VV[3];
if((simple_symlispcall_no_event(VV[45],base+1,2))!=Cnil){
goto T35;}
base[1]= base[0];
base[2]= VV[4];
if((simple_symlispcall_no_event(VV[45],base+1,2))==Cnil){
goto T36;}
T35:;
base[1]= symbol_value(VV[0]);
base[2]= VV[5];
base[3]= base[0];
vs_top=(vs_base=base+1)+3;
Lformat();
vs_top=sup;
goto T27;
T36:;
base[1]= base[0];
(void)simple_symlispcall_no_event(VV[46],base+1,1);
T27:;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for WT-H1 */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
if(!(type_of(base[0])==t_cons)){
goto T50;}
base[1]= get(car(base[0]),VV[6],Cnil);
if((base[1])==Cnil){
goto T54;}
base[2]= base[1];
{object V4;
V4= cdr(base[0]);
vs_top=base+3;
while(!endp(V4))
{vs_push(car(V4));V4=cdr(V4);}
vs_base=base+3;}
super_funcall_no_event(base[2]);
vs_top=sup;
goto T48;
T54:;
base[2]= VV[7];
base[3]= base[0];
(void)simple_symlispcall_no_event(VV[47],base+2,2);
goto T48;
T50:;
(void)(princ(base[0],symbol_value(VV[8])));
T48:;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for WT-DATA */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
bds_bind(VV[9],Cnil);
bds_bind(VV[10],VV[11]);
bds_bind(VV[12],Ct);
bds_bind(VV[13],Cnil);
bds_bind(VV[14],Cnil);
bds_bind(VV[15],Cnil);
bds_bind(VV[16],VV[17]);
bds_bind(VV[18],Ct);
bds_bind(VV[19],Ct);
bds_bind(VV[20],Ct);
bds_bind(VV[21],Ct);
princ_char(10,VV[22]);
(void)(prin1(base[0],symbol_value(VV[22])));
base[12]= Cnil;
vs_top=(vs_base=base+12)+1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;
}
/* function definition for WT-DATA-BEGIN */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(0);
vs_top=sup;
TTL:;
princ_str(" ",VV[22]);
princ_char(10,VV[22]);
princ_str("#(",VV[22]);
base[0]= Cnil;
vs_top=(vs_base=base+0)+1;
return;
}
/* function definition for WT-DATA-END */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(0);
vs_top=sup;
TTL:;
princ_char(10,VV[22]);
princ_char(41,VV[22]);
princ_char(10,VV[22]);
base[0]= Cnil;
vs_top=(vs_base=base+0)+1;
return;
}
/* function definition for WT-DATA-PACKAGE-OPERATION */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(1);
vs_top=sup;
TTL:;
princ_char(10,VV[22]);
princ_str("#!",VV[22]);
base[1]= base[0];
vs_top=(vs_base=base+1)+1;
L4();
return;
}
/* macro definition for WT */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
check_arg(2);
vs_top=sup;
{object V5=base[0]->c.c_cdr;
base[2]= V5;
base[3]= Cnil;}
{object V6;
object V7;
V6= base[2];
V7= car((V6));
T75:;
if(!(endp((V6)))){
goto T76;}
base[4]= make_cons(Cnil,base[3]);
base[5]= reverse(base[4]);
base[6]= make_cons(VV[23],base[5]);
vs_top=(vs_base=base+6)+1;
return;
T76:;
if(!(type_of((V7))==t_string)){
goto T82;}
base[4]= list(3,VV[24],(V7),VV[0]);
base[3]= make_cons(base[4],base[3]);
goto T80;
T82:;
base[4]= list(2,VV[25],(V7));
base[3]= make_cons(base[4],base[3]);
T80:;
V6= cdr((V6));
V7= car((V6));
goto T75;}
}
/* macro definition for WT-H */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
check_arg(2);
vs_top=sup;
{object V8=base[0]->c.c_cdr;
base[2]= V8;
base[3]= Cnil;}
if(!(endp(base[2]))){
goto T93;}
base[4]= VV[26];
vs_top=(vs_base=base+4)+1;
return;
T93:;
if(!(type_of(car(base[2]))==t_string)){
goto T96;}
{object V9;
object V10;
V9= cdr(base[2]);
V10= car((V9));
T101:;
if(!(endp((V9)))){
goto T102;}
base[5]= VV[27];
base[6]= VV[28];
base[7]= car(base[2]);
base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
base[5]= list(3,VV[24],base[4],VV[8]);
base[6]= make_cons(Cnil,base[3]);
base[7]= reverse(base[6]);
base[8]= listA(3,VV[23],base[5],base[7]);
vs_top=(vs_base=base+8)+1;
return;
T102:;
if(!(type_of((V10))==t_string)){
goto T112;}
base[4]= list(3,VV[24],(V10),VV[8]);
base[3]= make_cons(base[4],base[3]);
goto T110;
T112:;
base[4]= list(2,VV[29],(V10));
base[3]= make_cons(base[4],base[3]);
T110:;
V9= cdr((V9));
V10= car((V9));
goto T101;}
T96:;
{object V11;
object V12;
V11= base[2];
V12= car((V11));
T124:;
if(!(endp((V11)))){
goto T125;}
base[4]= make_cons(Cnil,base[3]);
base[5]= reverse(base[4]);
base[6]= listA(3,VV[23],VV[30],base[5]);
vs_top=(vs_base=base+6)+1;
return;
T125:;
if(!(type_of((V12))==t_string)){
goto T131;}
base[4]= list(3,VV[24],(V12),VV[8]);
base[3]= make_cons(base[4],base[3]);
goto T129;
T131:;
base[4]= list(2,VV[29],(V12));
base[3]= make_cons(base[4],base[3]);
T129:;
V11= cdr((V11));
V12= car((V11));
goto T124;}
}
/* macro definition for WT-NL */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
check_arg(2);
vs_top=sup;
{object V13=base[0]->c.c_cdr;
base[2]= V13;
base[3]= Cnil;}
if(!(endp(base[2]))){
goto T142;}
base[4]= VV[31];
vs_top=(vs_base=base+4)+1;
return;
T142:;
if(!(type_of(car(base[2]))==t_string)){
goto T145;}
{object V14;
object V15;
V14= cdr(base[2]);
V15= car((V14));
T150:;
if(!(endp((V14)))){
goto T151;}
base[5]= VV[27];
base[6]= VV[32];
base[7]= car(base[2]);
base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
base[5]= list(3,VV[24],base[4],VV[0]);
base[6]= make_cons(Cnil,base[3]);
base[7]= reverse(base[6]);
base[8]= listA(3,VV[23],base[5],base[7]);
vs_top=(vs_base=base+8)+1;
return;
T151:;
if(!(type_of((V15))==t_string)){
goto T161;}
base[4]= list(3,VV[24],(V15),VV[0]);
base[3]= make_cons(base[4],base[3]);
goto T159;
T161:;
base[4]= list(2,VV[25],(V15));
base[3]= make_cons(base[4],base[3]);
T159:;
V14= cdr((V14));
V15= car((V14));
goto T150;}
T145:;
{object V16;
object V17;
V16= base[2];
V17= car((V16));
T173:;
if(!(endp((V16)))){
goto T174;}
base[4]= make_cons(Cnil,base[3]);
base[5]= reverse(base[4]);
base[6]= listA(3,VV[23],VV[33],base[5]);
vs_top=(vs_base=base+6)+1;
return;
T174:;
if(!(type_of((V17))==t_string)){
goto T180;}
base[4]= list(3,VV[24],(V17),VV[0]);
base[3]= make_cons(base[4],base[3]);
goto T178;
T180:;
base[4]= list(2,VV[25],(V17));
base[3]= make_cons(base[4],base[3]);
T178:;
V16= cdr((V16));
V17= car((V16));
goto T173;}
}
/* macro definition for WT-NL1 */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
check_arg(2);
vs_top=sup;
{object V18=base[0]->c.c_cdr;
base[2]= V18;
base[3]= Cnil;}
if(!(endp(base[2]))){
goto T191;}
base[4]= VV[34];
vs_top=(vs_base=base+4)+1;
return;
T191:;
if(!(type_of(car(base[2]))==t_string)){
goto T194;}
{object V19;
object V20;
V19= cdr(base[2]);
V20= car((V19));
T199:;
if(!(endp((V19)))){
goto T200;}
base[5]= VV[27];
base[6]= VV[35];
base[7]= car(base[2]);
base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
base[5]= list(3,VV[24],base[4],VV[0]);
base[6]= make_cons(Cnil,base[3]);
base[7]= reverse(base[6]);
base[8]= listA(3,VV[23],base[5],base[7]);
vs_top=(vs_base=base+8)+1;
return;
T200:;
if(!(type_of((V20))==t_string)){
goto T210;}
base[4]= list(3,VV[24],(V20),VV[0]);
base[3]= make_cons(base[4],base[3]);
goto T208;
T210:;
base[4]= list(2,VV[25],(V20));
base[3]= make_cons(base[4],base[3]);
T208:;
V19= cdr((V19));
V20= car((V19));
goto T199;}
T194:;
{object V21;
object V22;
V21= base[2];
V22= car((V21));
T222:;
if(!(endp((V21)))){
goto T223;}
base[4]= make_cons(Cnil,base[3]);
base[5]= reverse(base[4]);
base[6]= listA(3,VV[23],VV[36],base[5]);
vs_top=(vs_base=base+6)+1;
return;
T223:;
if(!(type_of((V22))==t_string)){
goto T229;}
base[4]= list(3,VV[24],(V22),VV[0]);
base[3]= make_cons(base[4],base[3]);
goto T227;
T229:;
base[4]= list(2,VV[25],(V22));
base[3]= make_cons(base[4],base[3]);
T227:;
V21= cdr((V21));
V22= car((V21));
goto T222;}
}